home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / xlisp-2.1 / step.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  5.8 KB  |  141 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         step.lsp
  5. ; RCS:          $Header: $
  6. ; Description:  A simple Lisp single-step debugger.
  7. ; Author:       Jonathan Engdahl (jengdahl on BIX)
  8. ; Created:      Jan-25-1987
  9. ; Modified:     Sat Oct  5 21:17:38 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. ;Title:  step.lsp
  29. ;Author: Jonathan Engdahl (jengdahl on BIX)
  30. ;Date:   Jan-25-1987
  31.  
  32. ;This file contains a simple Lisp single-step debugger. It
  33. ;started as an implementation of the "hook" example in chapter 20
  34. ;of Steele's "Common Lisp". This version was brought up on Xlisp 1.7
  35. ;for the Amiga, and then on VAXLISP.
  36.  
  37. ;To invoke: (step (whatever-form with args))
  38. ;For each list (interpreted function call), the stepper prints the
  39. ;environment and the list, then enters a read-eval-print loop
  40. ;At this point the available commands are:
  41.  
  42. ;    (a list)<CR> - evaluate the list in the current environment,
  43. ;                   print the result, and repeat.                 
  44. ;    <CR> - step into the called function
  45. ;    anything_else<CR> - step over the called function.
  46.  
  47. ;If the stepper comes to a form that is not a list it prints the form 
  48. ;and the value, and continues on without stopping.
  49.  
  50. ;Note that stepper commands are executed in the current environment.
  51. ;Since this is the case, the stepper commands can change the current
  52. ;environment. For example, a SETF will change an environment variable
  53. ;and thus can alter the course of execution.
  54.  
  55.  
  56. ;set the representation for an input #/newline
  57. ;the value, notation, and data type of newline may be implementation dependent
  58. (setf newline #\newline)   ;for VAXLISP
  59. ;(setf newline 10)           ;for XLISP
  60.  
  61. ;define a C-like iterator.
  62. (defmacro while (test &rest forms) `(do () ((not ,test)) ,@forms))
  63.  
  64. ;create the nesting level counter.
  65. (setf *hooklevel* 0)
  66.  
  67. ;this macro invokes the stepper.
  68. ;for VAXLISP you better rename this to xstep or something, lest
  69. ;defun say nasty things to you about step already being defined
  70.  
  71. (defmacro step (form &aux val)
  72.      `(progn
  73.        (step-flush)                  ;get rid of garbage on the line
  74.        (setf *hooklevel* 0)          ;init nesting counter
  75.        (princ *hooklevel*)           ;print the form
  76.        (princ "  form: ")
  77.        (prin1 ',form)
  78.        (terpri)
  79.        (setf val (evalhook ',form    ;eval, and kick off stepper
  80.                            #'eval-hook-function
  81.                            nil
  82.                            nil))
  83.        (princ *hooklevel*)           ;print returned value
  84.        (princ " value: ")
  85.        (prin1 val)
  86.        (terpri)
  87.        val))                         ;and return it
  88.  
  89.  
  90. ;this is the substitute "eval" routine that gets control when
  91. ;a user form is evaluated during stepping.
  92.  
  93. (defun eval-hook-function (form env &aux val f1)
  94.      (setf *hooklevel* (+ *hooklevel* 1))    ;inc the nesting level
  95.      (cond ((consp form)                     ;if interpreted function 
  96.             (step-spaces *hooklevel*)        ;print the environment
  97.             (princ *hooklevel*)
  98.             (princ "    env: ")
  99.             (prin1 env)
  100.             (terpri)
  101.             (step-spaces *hooklevel*)        ;then the form
  102.             (princ *hooklevel*)
  103.             (princ "   form: ")
  104.             (prin1 form)
  105.             (princ " ")
  106.             (while (eql (peek-char) #\( )    ;while a form is typed           
  107.                    (setf f1 (read))          ;read a form
  108.                    (step-flush)              ;get rid of junk
  109.                    (step-spaces *hooklevel*) ;print out result
  110.                    (princ *hooklevel*)
  111.                    (princ " result: ")       ;which is evaled in env
  112.                    (prin1 (evalhook f1 nil nil env))
  113.                    (princ " "))   
  114.             (cond ((eql (read-char) newline) ;if <cr> then step into
  115.                    (setf val (evalhook form
  116.                                        #'eval-hook-function
  117.                                        nil
  118.                                        env)))
  119.                   (t (step-flush)            ;else step over
  120.                      (setf val (evalhook form nil nil env)))))
  121.            (t (step-spaces *hooklevel*)      ;if not interpreted func
  122.               (princ *hooklevel*)            ;print the form
  123.               (princ "   form: ")
  124.               (prin1 form)
  125.               (terpri)
  126.               (setf val (evalhook form nil nil env)))) ;eval it
  127.      (step-spaces *hooklevel*)               ;in either case
  128.      (princ *hooklevel*)                     ;print the result
  129.      (princ "  value: ")
  130.      (prin1 val)
  131.      (terpri)
  132.      (setf *hooklevel* (- *hooklevel* 1))    ;decrement level
  133.      val)                                    ;and return the value
  134.  
  135.  
  136. ;a non-recursive fn to print spaces (not as elegant, easier on the gc)
  137. (defun step-spaces (n) (while (> n 0) (princ " ") (setf n (- n 1))))
  138.      
  139. ;and one to clear the input buffer
  140. (defun step-flush () (while (not (eql (read-char) newline))))
  141.